home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1988 October / 1988-10.d64 / sp font editor (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  246 lines
  1. 10 rem copyright 1988 compute! publications, inc. - all rights reserved
  2. 20 print"[147][208]lease wait...":gosub2220:goto820
  3. 30 print"[147]":gosub2220:goto820
  4. 40 rem draw screen
  5. 50 rem   given c=char #, ch=addr of char
  6. 60 gosub260:iffl%(c)thengosub210:gosub320:goto80
  7. 70 gosub240:gosub290
  8. 80 rem entry w/o grid
  9. 90 printvt$(16)tab(14)"[152]<--[213]"
  10. 100 print""tab(16)"[211]peed[208]rint [198]ont [197]ditor"
  11. 110 printtab(20)"[152][195]opyright 1988":printtab(16)"[195][207][205][208][213][212][197]! [208]ublications"
  12. 120 printtab(17)"[193]ll [210]ights [210]eserved"
  13. 130 printvt$(8)t$"[155]---  [195]ommands  ---":printt$"<cursor keys>"
  14. 140 printt$"<[210][197][212][213][210][206]><[200][207][205][197]><[195][204][210]>":printt$"<[211][208][195]>[152]  toggle pixel"
  15. 150 printt$"+[152] next char":printt$"-[152] prev char"
  16. 160 printt$"shft +[152] next entry":printt$"shft -[152] prev entry"
  17. 170 printt$"[208][152]rint current char":printt$"shft [208][152] print string"
  18. 180 printt$"[199][152]oto     [195][152]opy":printt$"[204][152]oad     [211][152]ave"
  19. 190 printt$"[201][152]nclude  [197][152]xclude":printt$"[193][152][211][195][201][201]    [209][152]uit"
  20. 200 return
  21. 210 rem draw grid
  22. 220 printco$(0)""bo$
  23. 230 fori=0to2:printco$(i);:forj=1to7:printli$:next:next:printbo$:return
  24. 240 rem erase grid
  25. 250 print"";:fori=1to23:print"              ":next:return
  26. 260 rem update char display
  27. 270 printvt$(3)tab(15)"[195]har: "qu$chr$(c)qu$
  28. 280 printvt$(3)tab(25)"= [195][200][210]$("c"[157] ) ":return
  29. 290 rem not altered message
  30. 300 printvt$(9)"[155]  *[195]haracter *":print"  *  [206]ot in  *":print"  *[193]lteration*"
  31. 310 print"  *   [204]ist   *":return
  32. 320 rem mem to grid
  33. 330 rem   given ch=addr of char
  34. 340 ad=ch:y=0
  35. 350 gosub420
  36. 360 fory=0to14step7
  37. 370 forx=0to5:by=peek(ad+x):ifby=0then400
  38. 380 bi=1:foryy=0to6:ifbiandbythenprintvt$(y+yy)tab(fnht(x))co$(y/7)" [146]"
  39. 390 bi=bi*2:nextyy
  40. 400 nextx:ad=ad+6:nexty
  41. 410 gosub440:return
  42. 420 rem wait
  43. 430 pokeso,0:printvt$(9)"******":print" wait ":print"******":return
  44. 440 rem end wait
  45. 450 printvt$(9)"      ":print"      ":print"      ":return
  46. 460 rem toggle pixel
  47. 470 rem   given set=0/1: clr/set, x,y=co-ords, ch=addr of char
  48. 480 by=ch+int(y/7)*6+x:bi=2^(y-int(y/7)*7):set=1+((peek(by)andbi)>0)
  49. 490 printvt$(y)tab(fnht(x))co$(y/7)set$(set);
  50. 500 pokeby,(peek(by)and255-bi)orbi*set
  51. 510 return
  52. 520 rem print string
  53. 530 rem   given ms$=string
  54. 540 open1,4,7:fori=0to2
  55. 550 fori=0to2:forj=0to1:mo=-(i=2andj=1):print#1,pb$;:fork=1tolen(ms$)
  56. 560 a=asc(mid$(ms$,k,1)):m=me+a*18:iffl%(a)then600
  57. 570 ifi<>1andmo=0thenprint#1,tx$" ";:goto610
  58. 580 ifi=1thenprint#1,tx$chr$(a);:goto610
  59. 590 print#1,hr$chr$(26)chr$(6)chr$(132);:goto610
  60. 600 print#1,hr$;:forl=0to5:print#1,chr$(peek(m+i*6+l)or128or4*mo);:next
  61. 610 next:next:print#1,hr$cr$tx$;:next:close1:return
  62. 620 rem inquire
  63. 630 rem   given ms$=message
  64. 640 pokeso,0:fori=1to10:geta$:next:ifm2$=""thenms$=ms$+" (y/n)?":goto660
  65. 650 m2$=m2$+" (y/n)?"
  66. 660 print""vt$(5)tab(15)ms$:print""tab(15)m2$
  67. 670 geta$:ifa$<>"y"anda$<>"n"then670
  68. 680 printtab(15)"[145][145]"bl$""tab(15)bl$:m2$="":return
  69. 690 rem message
  70. 700 rem   given ms$,m2$=message
  71. 710 pokeso,0:print""vt$(5)tab(15)ms$:printtab(15)m2$
  72. 720 fori=1to2500:next:m2$="":print"[145][145]"tab(15)bl$""tab(15)bl$:return
  73. 730 rem set cursor
  74. 740 pokevic,cx*8+72:pokevic+1,cy*8+59:pokeso,1
  75. 750 rem get command
  76. 760 pokeso,1:pokesc,peek(sc)-1:geta$:ifa$=""then760
  77. 770 ifa$=cr$then960
  78. 780 fori=1to21:ifa$<>mid$("[145][157] +-[219][221]giepq[147]cls[208]a",i,1)thennext:goto760
  79. 790 on i goto840,870,900,930,980,1000,1050,1100,1150,1200
  80. 800 on i-10 goto1240,1270,1290,1340,1370,1400,1420,1490,1740,2130
  81. 810 on i-20goto2180
  82. 820 rem clr and cont
  83. 830 print"[147]":gosub40:goto730
  84. 840 rem up
  85. 850 cy=cy-1:ifcy<0thency=20
  86. 860 goto730
  87. 870 rem down
  88. 880 cy=cy+1:ifcy>20thency=0
  89. 890 goto730
  90. 900 rem left
  91. 910 cx=cx-1:ifcx<0thencx=5
  92. 920 goto730
  93. 930 rem right
  94. 940 cx=cx+1:ifcx>5thencx=0
  95. 950 goto730
  96. 960 rem return
  97. 970 cx=0:goto870
  98. 980 rem toggle
  99. 990 x=cx:y=cy:gosub460:goto750
  100. 1000 rem +
  101. 1010 gosub240
  102. 1020 c=c+1:ifc>255thenc=32
  103. 1030 gosub260:ch=me+c*18:geta$:ifa$="+"then1020
  104. 1040 gosub40:goto750
  105. 1050 rem -
  106. 1060 gosub240
  107. 1070 c=c-1:ifc<32thenc=255
  108. 1080 gosub260:ch=me+c*18:geta$:ifa$="-"then1070
  109. 1090 gosub40:goto750
  110. 1100 rem shft +
  111. 1110 j=c:gosub240:gosub420
  112. 1120 c=c+1:ifc>255thenc=32
  113. 1130 iffl%(c)=0andc<>jthen1120
  114. 1140 ch=me+c*18:gosub40:goto750
  115. 1150 rem shft -
  116. 1160 j=c:gosub240:gosub420
  117. 1170 c=c-1:ifc<32thenc=255
  118. 1180 iffl%(c)=0andc<>jthen1170
  119. 1190 goto1140
  120. 1200 rem goto
  121. 1210 pokeso,0:input"[147][199]oto [215]hich [193][211][195][201][201] [195]ode";a
  122. 1220 ifa>31anda<256thenc=a:ch=me+18*c
  123. 1230 goto820
  124. 1240 rem include
  125. 1250 fl%(c)=1
  126. 1260 gosub40:goto750
  127. 1270 rem exclude
  128. 1280 fl%(c)=0:goto1260
  129. 1290 rem p
  130. 1300 iffl%(c)=0then750
  131. 1310 ms$="[208]rint [212]his [195]har":gosub620
  132. 1320 ifa$="y"thenms$=" "+chr$(c)+" ":gosub520
  133. 1330 goto750
  134. 1340 rem quit
  135. 1350 ms$="[209]uit [208]rogram":gosub620:ifa$="y"thenprint"[147][155][194]ye.":pokeso,0:end
  136. 1360 goto750
  137. 1370 rem clr
  138. 1380 ms$="[195]lear [195]har":gosub620:ifa$="n"then750
  139. 1390 fori=chtoch+17:pokei,0:next:gosub40:goto750
  140. 1400 rem home
  141. 1410 cx=0:cy=0:goto730
  142. 1420 rem copy
  143. 1430 pokeso,0:print"[147][195]opy this [195]haracter to [215]hich [193][211][195][201][201]":a=0
  144. 1440 input"  [195]haracter";a:ifa>255ora<32ora=cthen820
  145. 1450 oc=c:c=a:c2=ch:ch=me+18*c:print"[147]":gosub40
  146. 1460 ms$="[210]eplace with"+str$(oc):gosub620
  147. 1470 ifa$="n"thenc=oc:ch=c2:ms$="** [195]ancelled **":gosub690:goto820
  148. 1480 fori=0to17:pokech+i,peek(c2+i):next:gosub40:goto750
  149. 1490 rem load
  150. 1500 ms$="[204]oad":gosub1630:iffl=1then820
  151. 1510 f2%=0:open15,8,15:open1,8,3,fi$:gosub2040:ifflthen820
  152. 1520 gosub240:gosub420:gosub2430:get#1,a$,a$,a$,a$:s=0
  153. 1530 get#1,a$:ifa$=""then1550
  154. 1540 s=s+1:o%(s)=asc(a$+c0$):get#1,a$:goto1530
  155. 1550 ifs=0then65535
  156. 1560 fori=1tos
  157. 1570 printw$;w$(iand3);:cc=o%(i):fl%(cc)=1:m=me+cc*18:forj=0to2:get#1,a$
  158. 1580 ifa$=chr$(255)thenfork=0to5:pokem+k,0:next:goto1600
  159. 1590 pokem,asc(a$+c0$):fork=1to5:get#1,a$:pokem+k,asc(a$+c0$):next
  160. 1600 m=m+6:next:next
  161. 1610 gosub80:gosub2040:iffl=0thenclose1:close15:ms$="[198]inished.":gosub690
  162. 1620 c=32:goto1100
  163. 1630 rem filename
  164. 1640 rem   given ms$=message
  165. 1650 rem   returns fi$=filename, fl=1 if error
  166. 1660 print"[147]"ms$":":fl=0:fi$="":input"[198]ilename";fi$
  167. 1670 ifleft$(fi$,4)="font"andmid$(fi$,7,1)="/"then1700
  168. 1680 input"2-character abbreviation";a$:iflen(a$)<>2then1680
  169. 1690 fi$="font"+a$+"/"+fi$
  170. 1700 print"[147]":gosub80
  171. 1710 iflen(fi$)>15thenms$="[198]ilename too long.":gosub690:fl=1:return
  172. 1720 ms$=ms$+" with [206]ame:":m2$=qu$+fi$+qu$:gosub620:ifa$="n"thenfl=1
  173. 1730 return
  174. 1740 rem save
  175. 1750 ms$="[211]ave":gosub1630:iffl=1then820
  176. 1760 open15,8,15
  177. 1770 open1,8,3,fi$+",w,p":input#15,a$,b$,c$,d$:a=val(a$)
  178. 1780 ifa<>63then1810
  179. 1790 close1:ms$="[210]eplace [198]ile":gosub620:ifa$="n"thenclose15:goto820
  180. 1800 print#15,"s0:"+fi$:goto1770
  181. 1810 ifa>19thengosub2060:goto820
  182. 1820 print#1,chr$(0)chr$(192);:gosub420:f2%=-(fl%(34)=0):iff2%=0then1850
  183. 1830 m=me+34*18:fori=mtom+17:pokei,0:next:pokem+7,7:pokem+9,7
  184. 1840 fl%(34)=1:rem make sure quote defined
  185. 1850 s=0:fori=32to255:s=s+fl%(i):next:s=1+2*s
  186. 1860 print#1,chr$(sand255)chr$(s/256);
  187. 1870 cc=32:i=0
  188. 1880 iffl%(cc)=0then1930
  189. 1890 ii=ii+1:printw$;w$(iiand3);
  190. 1900 s%=3:m=me+cc*18:fori=0to12step6:s=0:forj=0to5:s=s+peek(m+i+j):next
  191. 1910 l%=-(s>0):s%=s%-5*(l%>0):l%(cc,i/6)=l%:next
  192. 1920 print#1,chr$(cc)chr$(s%);
  193. 1930 cc=cc+1:ifcc<256then1880
  194. 1940 print#1,chr$(0);:cc=32
  195. 1950 iffl%(cc)=0then2000
  196. 1960 ii=ii+1:printw$;w$(iiand3);
  197. 1970 m=me+cc*18:fori=0to2:ifl%(cc,i)=0thenprint#1,chr$(255);:goto1990
  198. 1980 forj=0to5:print#1,chr$(peek(m+j));:next
  199. 1990 m=m+6:next
  200. 2000 cc=cc+1:ifcc<256then1950
  201. 2010 close1:gosub440:gosub2040:iffl=0thenms$="[198]inished.":gosub690
  202. 2020 iff2%thenfl%(34)=0
  203. 2030 close15:goto820
  204. 2040 rem read error
  205. 2050 input#15,a$,b$,c$,d$:a=val(a$)
  206. 2060 rem entry if already read
  207. 2070 ifa<20thenfl=0:return
  208. 2080 print"[147][196]isk [197]rror:":printa$" "b$" "c$" "d$" ":fl=1:close1:close15
  209. 2090 print"[208]ress [193]ny [203]ey to [195]ontinue....":fori=1to10:geta$:next
  210. 2100 geta$:ifa$=""then2100
  211. 2110 iff2%thenfl%(34)=0
  212. 2120 return
  213. 2130 rem shft p
  214.